home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / bix03.arc / METER.PAS < prev    next >
Pascal/Delphi Source File  |  1986-08-04  |  5KB  |  106 lines
  1. {*************************************************************************}
  2. {                                                                         }
  3. {                               METER                                     }
  4. {    Copyright by Ron Sparks - Not for Sale without Written Permission    }
  5. {            Personal use is approved without permission if the           }
  6. {                      author's name is included                          }
  7. {                                                                         }
  8. {                  First version - April 12, 1986                         }
  9. {                                                                         }
  10. {                          Revision History:                              }
  11. {                                                                         }
  12. {                      Date          Modification                         }
  13. {                      ======        ===============================      }
  14. {                                                                         }
  15. {                                                                         }
  16. {                                                                         }
  17. {                                                                         }
  18. {                           GENERAL COMMENTS                              }
  19. {                           ----------------                              }
  20. {    This routine draws a meter for monitoring the progress of any        }
  21. {    process.  It uses standard IBM compatible graphics characters        }
  22. {    and is "well behaved" and a little slow.  It autoscales the tic      }
  23. {    marks.  If first is True then the entire meter is drawn otherwise    }
  24. {    only the center bar is updated.  X and Y are the coordinates of the  }
  25. {    top left corner of the meter and Lngth is the length (characters)    }
  26. {    of the meter.  The minimum length is 9 and this gives only two       }
  27. {    characters to the indicator.  The input is in percent and is a       }
  28. {    real number.  Only whole percents are shown in the digital readout   }
  29. {                                                                         }
  30. {*************************************************************************}
  31. {----------------------------------------------------------------> METER  }
  32.  
  33. PROCEDURE Meter(VAR x, y, Lngth : Integer; VAR pct : Real;
  34.                 VAR first : Boolean);
  35. CONST
  36.   tl = $C9;
  37.   bl = $C8;
  38.   tr : STRING[6] = '';
  39.   br : STRING[6] = '';
  40.   dv = $BA;
  41.   sv = $B3;
  42.   tic = $D1;
  43.   toc = $CF;
  44.   maxwid : Integer = 80;
  45.   maxht : Integer = 25;
  46. VAR
  47.   size, indx, test, markr : Integer;
  48.   step, here, next : Real;
  49.   line1, line2, line3 : STRING[73];
  50.  
  51. BEGIN
  52.   tr := Chr($D1)+Chr($CD)+Chr($CD)+Chr($CD)+Chr($CD)+Chr($BB);
  53.   br := Chr($CF)+Chr($CD)+Chr($CD)+Chr($CD)+Chr($CD)+Chr($BC);
  54.   line1 := '';
  55.   line2 := '';
  56.   line3 := '';
  57.   IF (NOT(((x+Lngth) > maxwid) OR ((y+3) > maxht) OR (Lngth < 9))) THEN
  58.     BEGIN
  59.       IF pct < 0 THEN pct := 0;
  60.       IF pct > 100 THEN pct := 100;
  61.       size := Lngth-7;
  62.       step := 100.0/size;
  63.       FOR indx := 1 TO size DO
  64.         BEGIN
  65.           IF ((indx*step) <= pct) THEN
  66.             line2[indx] := Chr($DB)
  67.           ELSE
  68.             line2[indx] := Chr($20);
  69.           line2[0] := Chr(Ord(line2[0])+1);
  70.         END;
  71.       GoToXY(x, y+1);
  72.       Write(Chr(dv), line2, Chr(sv), pct:3:0, '%', Chr(dv));
  73.       IF first THEN
  74.         BEGIN
  75.           test := Round(1.5*step);
  76.           markr := 100;
  77.           IF test <= 10 THEN markr := 10;
  78.           IF (10 < test) AND (test <= 25) THEN markr := 25;
  79.           IF (test > 25) AND (test <= 50) THEN markr := 50;
  80.           FOR indx := 1 TO size DO
  81.             BEGIN
  82.               here := indx*step;
  83.               next := (indx+1)*step;
  84.               IF ((Trunc(next/markr)-Trunc(here/markr)) = 1) THEN
  85.                 BEGIN
  86.                   line1[indx] := Chr(tic);
  87.                   line3[indx] := Chr(toc);
  88.                 END
  89.               ELSE
  90.                 BEGIN
  91.                   line1[indx] := Chr($CD);
  92.                   line3[indx] := Chr($CD);
  93.                 END;
  94.               line1[0] := Chr(Ord(line1[0])+1);
  95.               line3[0] := Chr(Ord(line3[0])+1);
  96.             END;
  97.           GoToXY(x, y);
  98.           Write(Chr(tl), line1, tr);
  99.           GoToXY(x, y+2);
  100.           Write(Chr(bl), line3, br);
  101.         END;
  102.     END;
  103. END;
  104.  
  105. {-------------------------------------------------------------< Meter     }
  106.